Visual Basic Source Code/Visual Basic Source Code.iso/vbsource/regedit/regmodul.bas

BASIC Source File | 1995-10-17 | 41.5 KB | 986 lines

Attribute VB_Name = "REGMODUL"
' --------------------------------------------------------
' This .BAS module contains functions for reading and
'   setting registry values in Windows 95 and Windows NT.
'   The demo is in the form of a functional registry editor,
'   although it is not meant to be a substitute for RegEdit
'   or RegEdt32.  Declares are not provided
'   for some rare registry functions, and not all functions
'   have demo usage implemented.  Only values of type REG_SZ
'   and REG_DWORD may be edited.
'
' Written 10/95 by Don Bradner, based on code originally developed
'   for VB3 using the CALL32 thunking file.  That file is not
'   needed or used with this demo.  Requirements to run include
'   VB4/32-bit, Windows 95 or NT 3.51 or later, and Comctl32.OCX,
'   which comes with VB4 Pro or EE versions.
'
' This material is placed in the public domain.  No guarantees
'   are made, and no support is provided, but comments/bug
'   reports are welcome to Don Bradner at Compuserve 76130,1007
'   or at [e-mail].  Questions/comments are also
'   welcome in the 32-bit section of the Visual Basic Programmer's
'   Journal forum on Compuserve.
'
' Warning:  Editing registry values can seriously impact your
'   computer's operations.  You should only edit values when
'   you know what they should be.  If editing values as a
'   test, make a note of the original value and restore it
'   when you are done.
' --------------------------------------------------------

Option Explicit

' --------------------------------------------------------
' FILETIME type is needed for RegEnumKey and
'   RegQueryInfoKey
' --------------------------------------------------------
Type FILETIME
    lLowDateTime    As Long
    lHighDateTime   As Long
End Type

' --------------------------------------------------------
' OsVersionInfo type is needed for GetVersionEx
' --------------------------------------------------------
Type OsVersionInfo
    dwVersionInfoSize As Long
    dwMajorVersion As Long
    dwMinorVersion As Long
    dwBuildNumber As Long
    dwPlatform As Long
    szCSDVersion As String * 128
End Type

Public RegEntry As New RegistryEntry

' ---------------------------
' 32-bit registry functions
' ---------------------------
Declare Function RegOpenKeyEx& Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hKey&, ByVal lpszSubKey$, dwOptions&, ByVal samDesired&, lpHKey&)
Declare Function RegCloseKey& Lib "advapi32.dll" (ByVal hKey&)
Declare Function RegQueryValueEx& Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey&, ByVal lpszValueName$, ByVal lpdwRes&, lpdwType&, ByVal lpDataBuff$, nSize&)
Declare Function RegSetValueEx& Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey&, ByVal lpszValueName$, ByVal dwRes&, ByVal dwType&, lpDataBuff As Any, ByVal nSize&)
Declare Function RegConnectRegistry& Lib "advapi32.dll" (ByVal lpMachineName$, ByVal hKey&, phkResult&)
Declare Function RegCreateKeyEx& Lib "advapi32.dll" Alias "RegCreateKeyExA" (ByVal hKey&, ByVal lpSubKey$, ByVal Reserved&, ByVal lpClass$, ByVal dwOptions&, ByVal samDesired&, lpSecurityAttributes&, phkResult&, lpdwDisposition&)
Declare Function RegFlushKey& Lib "advapi32.dll" (ByVal hKey&)
Declare Function RegEnumKeyEx& Lib "advapi32.dll" Alias "RegEnumKeyExA" (ByVal hKey&, ByVal dwIndex&, ByVal lpName$, lpcbName&, ByVal lpReserved&, ByVal lpClass$, lpcbClass&, lpftLastWriteTime As FILETIME)
Declare Function RegEnumValue& Lib "advapi32.dll" Alias "RegEnumValueA" (ByVal hKey&, ByVal dwIndex&, ByVal lpName$, lpcbName&, ByVal lpReserved&, lpdwType&, lpValue As Any, lpcbValue&)
Declare Function RegQueryInfoKey& Lib "advapi32.dll" Alias "RegQueryInfoKeyA" (ByVal hKey&, ByVal lpClass$, lpcbClass&, ByVal lpReserved&, lpcSubKeys&, lpcbMaxSubKeyLen&, lpcbMaxClassLen&, lpcValues&, lpcbMaxValueNameLen&, lpcbMaxValueLen&, lpcbSecurityDescriptor&, lpftLastWriteTime As FILETIME)

Declare Function GetVersionEx& Lib "kernel32.dll" Alias "GetVersionExA" (lpStruct As OsVersionInfo)

' --------------------------------------------------------
' Functions used to show hourglass
' --------------------------------------------------------
Declare Function LoadCursor& Lib "User32" Alias "LoadCursorA" (ByVal hInstance&, ByVal lpCursor&)
Declare Function SetCursor& Lib "User32" (ByVal hCursor&)
Public Const IDC_WAIT = 32514&

Public iWaitCursor&

Public lNewKey& 'used to generate unique Node keys

' --------------------------------------------------------
' Return codes from Registration functions.
' --------------------------------------------------------
Const ERROR_SUCCESS = 0&
Const ERROR_BADDB = 1009&
Const ERROR_BADKEY = 1010&
Const ERROR_CANTOPEN = 1011&
Const ERROR_CANTREAD = 1012&
Const ERROR_CANTWRITE = 1013&
Const ERROR_OUTOFMEMORY = 14&
Const ERROR_INVALID_PARAMETER = 87&
Const ERROR_ACCESS_DENIED = 5&
Const ERROR_NO_MORE_ITEMS = 259&
Const ERROR_MORE_DATA = 234&

Public Const HKEY_CLASSES_ROOT = &H80000000
Public Const HKEY_CURRENT_USER = &H80000001
Public Const HKEY_LOCAL_MACHINE = &H80000002
Public Const HKEY_USERS = &H80000003
Public Const HKEY_PERFORMANCE_DATA = &H80000004
Public Const HKEY_CURRENT_CONFIG = &H80000005
Public Const HKEY_DYN_DATA = &H80000006

Public Const LB_SETHORIZONTALEXTENT = &H400 + 21

Const REG_NONE = 0&                        ' No value type
Public Const REG_SZ = 1&                   ' Unicode nul terminated string
Const REG_EXPAND_SZ = 2&                   ' Unicode nul terminated string
                                           ' (with environment variable references)
Const REG_BINARY = 3&                      ' Free form binary
Public Const REG_DWORD = 4&                ' 32-bit number
Const REG_DWORD_LITTLE_ENDIAN = 4&         ' 32-bit number (same as REG_DWORD)
Const REG_DWORD_BIG_ENDIAN = 5&            ' 32-bit number
Const REG_LINK = 6&                        ' Symbolic Link (unicode)
Const REG_MULTI_SZ = 7&                    ' Multiple Unicode strings
Const REG_RESOURCE_LIST = 8&               ' Resource list in the resource map
Const REG_FULL_RESOURCE_DESCRIPTOR = 9&    ' Resource list in the hardware description
Const REG_RESOURCE_REQUIREMENTS_LIST = 10&


' --------------------------------------------------------
' Read/Write permissions:
' --------------------------------------------------------
Const KEY_QUERY_VALUE = &H1&
Const KEY_SET_VALUE = &H2&
Const KEY_CREATE_SUB_KEY = &H4&
Const KEY_ENUMERATE_SUB_KEYS = &H8&
Const KEY_NOTIFY = &H10&
Const KEY_CREATE_LINK = &H20&
Const READ_CONTROL = &H20000
Const WRITE_DAC = &H40000
Const WRITE_OWNER = &H80000
Const SYNCHRONIZE = &H100000
Const STANDARD_RIGHTS_REQUIRED = &HF0000
Const STANDARD_RIGHTS_READ = READ_CONTROL
Const STANDARD_RIGHTS_WRITE = READ_CONTROL
Const STANDARD_RIGHTS_EXECUTE = READ_CONTROL
Const KEY_READ = STANDARD_RIGHTS_READ Or KEY_QUERY_VALUE Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY
Const KEY_WRITE = STANDARD_RIGHTS_WRITE Or KEY_SET_VALUE Or KEY_CREATE_SUB_KEY
Const KEY_EXECUTE = KEY_READ


' --------------------------------------------------------
' Used with GetVersionEX
' --------------------------------------------------------
Public iWinVers%
Public Const WinNt = 1
Public Const Win32 = 2

Public Const VER_PLATFORM_WIN32_WINDOWS = 1
Public Const VER_PLATFORM_WIN32_NT = 2


' --------------------------------------------------------
' Public program variables
' --------------------------------------------------------
Public lTempLong&
Public fTempDbl#
Public sTempString$


Sub CenterForm(FormName As Form)
    FormName.Move (Screen.Width - FormName.Width) / 2, (Screen.Height - FormName.Height) / 2
End Sub

Sub EditRegValue(ByVal nodX As Node, lRegIndex&)
    ' --------------------------------------------------------
    ' Specific to the RegDemo application.
    ' --------------------------------------------------------
    RegEntry.rgeSubKey = nodX.FullPath
    RegEntry.rgeSubKey = Right$(RegEntry.rgeSubKey, Len(RegEntry.rgeSubKey) - 12)
    If InStr(RegEntry.rgeSubKey, "\") = 0 Then
        RegEntry.rgeMainKey = GetMainKey(RegEntry.rgeSubKey)
        RegEntry.rgeSubKey = ""
    Else
        '-------------------------------------------------
        'This must be a SubKey.
        '-------------------------------------------------
        RegEntry.rgeMainKey = GetMainKey(Left$(RegEntry.rgeSubKey, InStr(RegEntry.rgeSubKey, "\") - 1))
        RegEntry.rgeSubKey = Right$(RegEntry.rgeSubKey, Len(RegEntry.rgeSubKey) - InStr(RegEntry.rgeSubKey, "\"))
    End If

    Dim lRtn&       ' Returned by registry functions, should be 0&
    Dim hKey&       ' Return handle to opened key
    Dim lLenValueName&
    Dim lLenValue&
    Dim lKeyIndx&

    ' --------------------------------------------------------
    ' values for QueryInfoKey:
    ' --------------------------------------------------------
    Dim sClassName$
    Dim lClassLen&
    Dim lSubKeys&
    Dim lMaxSubKey&
    Dim lMaxClass&
    Dim lValues&
    Dim lMaxValueName&
    Dim lMaxValueData&
    Dim lSecurityDesc&
    Dim strucLastWriteTime As FILETIME

    ' -----------------------------------------------------
    ' Open key
    ' -----------------------------------------------------
    lRtn = RegOpenKeyEx(RegEntry.rgeMainKey, RegEntry.rgeSubKey, 0&, KEY_READ, hKey)
    If lRtn <> ERROR_SUCCESS Then
        MsgBox RtnRegError(lRtn)

        ' --------------------------------------------------
        ' No key open, so leave
        ' --------------------------------------------------
        Exit Sub
    End If

    ' -----------------------------------------------------
    ' RegQueryInfoKey is used to get the size of the largest
    '   value name and data string.
    ' Other returned values are ignored.
    ' -----------------------------------------------------
    sClassName = Space$(255) 'initialize these because occasional errors otherwise
    lClassLen = CLng(Len(sClassName))
    lRtn = RegQueryInfoKey(hKey, sClassName, lClassLen, 0&, lSubKeys, lMaxSubKey, lMaxClass, lValues, lMaxValueName, lMaxValueData, lSecurityDesc, strucLastWriteTime)

    '-------------------------------------------------------------------
    'If the enumeration fails due to a buffer over-run, we will loop back
    'to this point with larger buffers.
    '-------------------------------------------------------------------
RetryValueHere:

    ' --------------------------------------------------
    ' Set variables
    ' --------------------------------------------------
    RegEntry.rgeEntry = Space$(lMaxValueName + 1)
    lLenValueName = CLng(Len(RegEntry.rgeEntry)) '+ 1
    RegEntry.rgeValue = Space$(lMaxValueData + 1)
    lLenValue = CLng(Len(RegEntry.rgeValue))       '+ 1

    ' --------------------------------------------------
    ' Call the enumeration function to get the indexed value
    ' --------------------------------------------------
    lRtn = RegEnumValue(hKey, lRegIndex, RegEntry.rgeEntry, lLenValueName, 0&, RegEntry.rgeDataType, ByVal RegEntry.rgeValue, lLenValue)


    ' --------------------------------------------------
    ' Check for success
    ' --------------------------------------------------
    If lRtn = ERROR_SUCCESS Then
        If RegEntry.rgeDataType <> REG_SZ And RegEntry.rgeDataType <> REG_DWORD Then

            '--------------------------------------------------------------
            'Tell us what value types may be edited, along with
            '    the type of value found.
            '--------------------------------------------------------------
            sTempString = "This Demo only supports editing of values with types of REG_SZ and REG_DWORD.  This value is of type "
            Select Case RegEntry.rgeDataType
                Case 2
                    sTempString = sTempString & "REG_EXPAND_SZ."
                Case 3
                    sTempString = sTempString & "REG_BINARY."
                Case 5
                    sTempString = sTempString & "REG_DWORD_BIG_ENDIAN."
                Case 6
                    sTempString = sTempString & "REG_LINK."
                Case 7
                    sTempString = sTempString & "REG_MULTI_SZ."
                Case 8
                    sTempString = sTempString & "REG_RESOURCE_LIST."
                Case 9
                    sTempString = sTempString & "REG_FULL_RESOURCE_DESCRIPTOR."
                Case 10
                    sTempString = sTempString & "REG_RESOURCE_REQUIREMENTS_LIST."
            End Select
            MsgBox sTempString

        Else
            RegEntry.rgeEntry = Mid$(RegEntry.rgeEntry, 1, lLenValueName)
            If lLenValueName = 0 Then
                RegEntry.rgeEntry = "(Default)"
            End If
            RegEntry.rgeValue = Mid$(RegEntry.rgeValue, 1, lLenValue)
            ' --------------------------------------------
            ' Convert DWORD 4 character value to 32-bit
            '   number.
            ' First character is low byte, and so on.
            ' --------------------------------------------
            Form2.Caption = "Edit String Value"
            If RegEntry.rgeDataType = REG_DWORD Then
                fTempDbl = Asc(Mid$(RegEntry.rgeValue, 1, 1)) + &H100& * Asc(Mid$(RegEntry.rgeValue, 2, 1)) + &H10000 * Asc(Mid$(RegEntry.rgeValue, 3, 1)) + &H1000000 * CDbl(Asc(Mid$(RegEntry.rgeValue, 4, 1)))
                If fTempDbl > &H7FFFFFFF Then
                    RegEntry.rgeValue = Hex$(fTempDbl - 4294967296#)
                Else
                    RegEntry.rgeValue = Hex$(fTempDbl)
                End If
                ' -----------------------------------------
                ' Turn on Hex/Decimal options
                ' -----------------------------------------
                Form2!Frame1.Visible = True
                Form2.Caption = "Edit DWORD Value"
            End If

            ' --------------------------------------------
            ' Place the values in the form2 text boxes
            ' --------------------------------------------
            Form2!Text1 = RegEntry.rgeEntry
            Form2!text2 = RegEntry.rgeValue

            ' --------------------------------------------
            ' Pass the key variables to form2 via hidden
            '   text boxes
            ' --------------------------------------------
            Form2.Show 1
        End If

    ElseIf lRtn = ERROR_MORE_DATA Then
        ' -----------------------------------------------
        ' This error means that, despite querying the key
        '   we have not set one of the buffers large
        '   enough. If the buffer is already 20000 we are
        '   not going to be able to edit it.
        ' -----------------------------------------------
        If lMaxValueData >= 20000 Then
            MsgBox ("Value is too large for this editor!")
        Else

            ' --------------------------------------------
            ' Increase the buffer sizes and try again
            ' --------------------------------------------
            lMaxValueData = lMaxValueData + 5
            lMaxValueName = lMaxValueName + 5
            GoTo RetryValueHere
        End If
    Else

        ' --------------------------------------------------
        ' Key still open, so display the error and fall
        '   thru to the close function below
        ' --------------------------------------------------
        MsgBox RtnRegError(lRtn)
    End If

    ' -----------------------------------------------------
    ' Always close opened keys!
    ' -----------------------------------------------------
    lRtn = RegCloseKey(hKey)

End Sub


Function GetMainKey&(keyname$)

   ' -----------------------------------------------------
   ' Used to convert main key strings to their values
   ' -----------------------------------------------------

    Select Case keyname
        Case "HKEY_CLASSES_ROOT"
            GetMainKey = HKEY_CLASSES_ROOT
        Case "HKEY_CURRENT_USER"
            GetMainKey = HKEY_CURRENT_USER
        Case "HKEY_LOCAL_MACHINE"
            GetMainKey = HKEY_LOCAL_MACHINE
        Case "HKEY_USERS"
            GetMainKey = HKEY_USERS
        Case "HKEY_PERFORMANCE_DATA"
            GetMainKey = HKEY_PERFORMANCE_DATA
        Case "HKEY_CURRENT_CONFIG"
            GetMainKey = HKEY_CURRENT_CONFIG
        Case "HKEY_DYN_DATA"
            GetMainKey = HKEY_DYN_DATA
    End Select

End Function


Function RegEnumKeys&(ByVal Node As Node, bFullEnumeration As Boolean)
    lTempLong = SetCursor(iWaitCursor)
    Dim sRoot$

    '-------------------------------------------------------------
    'Because we will recurse this function we need to make a
    'separate instance of RegistryEntry to avoid altering a
    'global property.
    '-------------------------------------------------------------
    Dim RegEnumEntry As New RegistryEntry
    RegEnumEntry.rgeSubKey = Node.FullPath
    If RegEnumEntry.rgeSubKey = "My Computer" Then Exit Function
        '---------------------------------------------
    'If we've put in a single key to set the + image,
    'remove that key to avoid duplication
    '---------------------------------------------
    While Node.Children > 0
        Form1!TreeView1.Nodes.Remove Node.Child.Key
    Wend
    RegEnumEntry.rgeExtractKeys
    sRoot = Node.Key
' --------------------------------------------------------
    ' This function will load all subkeys into the TreeView
    '   iLevels tells us how far to indent, while
    '   iStartList tells us where we are in the TreeView
    ' --------------------------------------------------------
    Dim lRtn&       ' Returned by registry functions, should be 0&
    Dim hKey&       ' Return handle to opened key
    Dim strucLastWriteTime    As FILETIME
    Dim sSubKeyName$
    Dim sClassString$
    Dim lLenSubKey&
    Dim lLenClass&
    Dim lKeyIndx&
    Dim lRet&
    Dim hKey2&
    Dim sSubKey2$
    Dim nodX As Node
    Dim sNewKey$

    '---------------------------------------------
    'values for QueryInfoKey:
    '---------------------------------------------
    Dim sClassName$
    Dim lClassLen&
    Dim lSubKeys&
    Dim lMaxSubKey&
    Dim lMaxClass&
    Dim lMaxSubKey2&  'Used for second QueryInfoKey in loop
    Dim lMaxClass2&   'Same
    Dim lValues&
    Dim lMaxValueName&
    Dim lMaxValueData&
    Dim lSecurityDesc&

    ' -----------------------------------------------------
    ' Open key
    ' -----------------------------------------------------
    lRtn = RegOpenKeyEx(RegEnumEntry.rgeMainKey, RegEnumEntry.rgeSubKey, 0&, KEY_READ, hKey)
    If lRtn <> ERROR_SUCCESS Then
        If lRtn = ERROR_ACCESS_DENIED Then
            '---------------------------------------------
            'Grey the key
            'otherwise report error condition
            '---------------------------------------------
            Node.Image = 6
            'Node.Enabled = False 'Doesn't work?
        Else
            MsgBox RtnRegError(lRtn)
        End If
        RegEnumKeys = lRtn
        Exit Function

        ' --------------------------------------------------
        ' No key open, so leave
        ' --------------------------------------------------
    End If

    ' -----------------------------------------------------
    ' A call to RegQueryInfoKey will tell us the maximum
    '   keyname length
    ' -----------------------------------------------------
    sClassName = Space$(255)
    lClassLen = CLng(Len(sClassName))
    lRet = RegQueryInfoKey(hKey, sClassName, lClassLen, 0&, lSubKeys, lMaxSubKey, lMaxClass, lValues, lMaxValueName, lMaxValueData, lSecurityDesc, strucLastWriteTime)

    ' -----------------------------------------------------
    ' Enumerate the keys
    ' -----------------------------------------------------
    lKeyIndx = 0&
    Do While lRtn = ERROR_SUCCESS

        ' -----------------------------------------------------
        ' If the enumeration fails due to a buffer over-run,
        '   we will loop back to this point with larger buffers.
        ' -----------------------------------------------------
ReTryKeyEnumeration:

        ' --------------------------------------------------
        ' Set variables
        ' --------------------------------------------------
        sSubKeyName = Space$(lMaxSubKey + 1)
        lLenSubKey = CLng(Len(sSubKeyName))
        sClassString = Space$(lMaxClass + 1)
        lLenClass = CLng(Len(sClassString))


        ' --------------------------------------------------
        ' Call the enumeration function
        ' --------------------------------------------------
        lRtn = RegEnumKeyEx(hKey, lKeyIndx, sSubKeyName, lLenSubKey, 0&, sClassString, lLenClass, strucLastWriteTime)
        If InStr(sSubKeyName, Chr$(0)) > 1 Then
            sSubKeyName = Left$(sSubKeyName, InStr(sSubKeyName, Chr$(0)) - 1)
        End If


        ' --------------------------------------------------
        ' Check for success
        ' --------------------------------------------------
        If lRtn = ERROR_SUCCESS Then
            sSubKey2 = sSubKeyName
            If RegEnumEntry.rgeSubKey <> "" Then
                sSubKey2 = Trim(RegEnumEntry.rgeSubKey) & "\" & sSubKeyName
             End If

            ' -----------------------------------------------
            ' Use RegQueryInfoKey to find out if this key has
            '   subkeys
            ' -----------------------------------------------
            lRet = RegOpenKeyEx(RegEnumEntry.rgeMainKey, sSubKey2, 0&, KEY_READ, hKey2)
            lNewKey = lNewKey + 1
            sNewKey = "A" & Format$(lNewKey, "000000")
            Set nodX = Form1!TreeView1.Nodes.Add(sRoot, tvwChild, sNewKey, sSubKeyName, 1)
            If bFullEnumeration = True Then
                '------------------------------------------------------
                'We are fully enumerating a key, so set images and
                'Recurse a single SubKey to set + indicator if there are
                'subkeys below this one
                '------------------------------------------------------
                lRet = RegEnumKeys(nodX, False)
                If lRet = ERROR_ACCESS_DENIED Then
                    nodX.ExpandedImage = 6
                    nodX.SelectedImage = 6
                Else
                    nodX.ExpandedImage = 2
                    nodX.SelectedImage = 2
                End If
            Else
                Exit Do
            End If
            lKeyIndx = lKeyIndx + 1
        ElseIf lRtn = ERROR_MORE_DATA Then
            ' -----------------------------------------------
            ' This error means that, despite querying the key
            '   we have not set one of the buffers large
            '   enough.Increment the buffer sizes and try
            '   again
            ' -----------------------------------------------
            lMaxSubKey = lMaxSubKey + 5
            lMaxClass = lMaxClass + 5
            GoTo ReTryKeyEnumeration
        ElseIf lRtn = ERROR_NO_MORE_ITEMS Then
            ' -----------------------------------------------
            ' Not an error, just end of list -- exit the
            '   loop
            ' -----------------------------------------------
            lRtn = ERROR_SUCCESS
            Exit Do
        ElseIf lRtn <> ERROR_SUCCESS Then
            ' --------------------------------------------------
            ' Key still open, so display the error and fall
            '   thru to the close function below
            ' --------------------------------------------------
            MsgBox RtnRegError(lRtn)
            Exit Do
        End If
    Loop


    ' -----------------------------------------------------
    ' Set the return to the last error
    ' -----------------------------------------------------
    RegEnumKeys = lRtn
    Set RegEnumEntry = Nothing

    ' -----------------------------------------------------
    ' Always close opened keys!
    ' -----------------------------------------------------
    lRtn = RegCloseKey(hKey)

End Function
Public Sub RegEnumValues()
    ' --------------------------------------------------------
    'Enter with RegEntry.rgeSubKey containing a full key path, in
    'My Computer\HKEY_..\..\ fashion
    ' --------------------------------------------------------
    Dim lRtn&        ' Returned by registry functions, should be 0&
    Dim hKey&       ' Return handle to opened key
    Dim lLenValueName&
    Dim lLenValue&
    Dim lKeyIndx&
    Dim sBinaryString$
    Dim Item As ListItem
    Dim iTempInt%

    '---------------------------
    'values for QueryInfoKey:
    '---------------------------
    Dim sClassName$
    Dim lClassLen&
    Dim lSubKeys&
    Dim lMaxSubKey&
    Dim lMaxClass&
    Dim lValues&
    Dim lMaxValueName&
    Dim lMaxValueData&
    Dim lSecurityDesc&
    Dim strucLastWriteTime As FILETIME

    Dim iListWidth%  'Used to set listbox scrollbar

    lTempLong = SetCursor(iWaitCursor)

    RegEntry.rgeExtractKeys

    ' -----------------------------------------------------
    ' Open key
    ' -----------------------------------------------------
    lRtn = RegOpenKeyEx(RegEntry.rgeMainKey, RegEntry.rgeSubKey, 0&, KEY_READ, hKey)
    If lRtn <> ERROR_SUCCESS Then
        If lRtn <> ERROR_ACCESS_DENIED Then
            '---------------------------------------------
            'If access is denied don't do anything
            '---------------------------------------------
            MsgBox RtnRegError(lRtn)
        End If
        RegEntry.rgeClear

        ' --------------------------------------------------
        ' No key open, so leave
        ' --------------------------------------------------
        Exit Sub
    End If

   ' -----------------------------------------------------
   ' Use RegQueryInfoKey to get the maximum value data info.
   ' -----------------------------------------------------
    sClassName = Space$(255)
    lClassLen = CLng(Len(sClassName))
    lRtn = RegQueryInfoKey(hKey, sClassName, lClassLen, 0&, lSubKeys, lMaxSubKey, lMaxClass, lValues, lMaxValueName, lMaxValueData, lSecurityDesc, strucLastWriteTime)


    ' -----------------------------------------------------
    ' Enumerate the keys
    ' -----------------------------------------------------
    lKeyIndx = 0&
    Do While lRtn = ERROR_SUCCESS
        sBinaryString = ""

'-------------------------------------------------------------------
'If the enumeration fails due to a buffer over-run, we will loop back
'to this point with larger buffers.
'-------------------------------------------------------------------
ReTryValueEnumeration:

        ' --------------------------------------------------
        ' Set variables
        ' --------------------------------------------------
        RegEntry.rgeEntry = Space$(lMaxValueName + 1)
        lLenValueName = CLng(Len(RegEntry.rgeEntry)) '+ 1
        RegEntry.rgeValue = Space$(lMaxValueData + 1)
        lLenValue = CLng(Len(RegEntry.rgeValue))       '+ 1


        ' --------------------------------------------------
        ' Call the enumeration function
        ' --------------------------------------------------
        lRtn = RegEnumValue(hKey, lKeyIndx, RegEntry.rgeEntry, lLenValueName, 0&, RegEntry.rgeDataType, ByVal RegEntry.rgeValue, lLenValue)


        ' --------------------------------------------------
        ' Check for success
        ' --------------------------------------------------
        If lRtn = ERROR_SUCCESS Then

            '-----------------------------------------------
            'Add an item to the list box
            '-----------------------------------------------
            Set Item = Form1!ListView1.ListItems.Add()

            ' -----------------------------------------------
            ' Start building the entry to put in the list box:
            ' -----------------------------------------------
            RegEntry.rgeEntry = Mid$(RegEntry.rgeEntry, 1, lLenValueName)

            ' -----------------------------------------------
            ' Default values don't have a name.
            ' -----------------------------------------------
            If lLenValueName = 0 Then
                RegEntry.rgeEntry = "(Default)"
            End If

            RegEntry.rgeValue = Mid$(RegEntry.rgeValue, 1, lLenValue)
            Select Case RegEntry.rgeDataType
                Case REG_MULTI_SZ
                    ' --------------------------------------
                    ' REG_MULTI_SZ strings are a series of
                    '   zero terminated strings. If we don't
                    '   strip out the zeros, only the first
                    '   one will display.
                    ' We will replace them with spaces.
                    ' --------------------------------------
                    Item.SmallIcon = 4
                    Do While InStr(RegEntry.rgeValue, Chr$(0))
                        RegEntry.rgeValue = Left$(RegEntry.rgeValue, InStr(RegEntry.rgeValue, Chr$(0)) - 1) & " " & Right$(RegEntry.rgeValue, Len(RegEntry.rgeValue) - InStr(RegEntry.rgeValue, Chr$(0)))
                    Loop
                Case REG_SZ
                    ' --------------------------------------
                    ' REG_SZ values are zero-terminated
                    '   strings, and are the most common
                    '   values.
                    ' --------------------------------------
                    Item.SmallIcon = 4

                    '---------------------------------------
                    'Put quotes around the string
                    '---------------------------------------
                    RegEntry.rgeValue = """" & Left$(RegEntry.rgeValue, lLenValue - 1) & """"

                Case REG_EXPAND_SZ
                    '---------------------------------------
                    'Environmental variables that are binary
                    'but evaluate as strings.  Not edited by
                    'this program.
                    '---------------------------------------
                    Item.SmallIcon = 5
                Case REG_FULL_RESOURCE_DESCRIPTOR
                    ' --------------------------------------
                    ' Resource Descriptors require a special
                    '   editor to properly be displayed or
                    '   edited.
                    ' --------------------------------------
                    Item.SmallIcon = 5
                    RegEntry.rgeValue = "REG_FULL_RESOURCE_DESCRIPTOR"

                Case REG_DWORD
                    ' --------------------------------------
                    ' REG_DWORD values are 32-bit unsigned
                    '   integers
                    ' Tortuous manipulation to make values
                    '   above 7FFFFFFF appear as positive
                    '   values.
                    ' VB Longs would display them as
                    '   negative numbers.
                    ' --------------------------------------
                    Item.SmallIcon = 5
                    fTempDbl = Asc(Mid$(RegEntry.rgeValue, 1, 1)) + &H100& * Asc(Mid$(RegEntry.rgeValue, 2, 1)) + &H10000 * Asc(Mid$(RegEntry.rgeValue, 3, 1)) + &H1000000 * CDbl(Asc(Mid$(RegEntry.rgeValue, 4, 1)))
                    If fTempDbl > &H7FFFFFFF Then
                        RegEntry.rgeValue = "&H" & Hex$(fTempDbl - 4294967296#)
                    Else
                        RegEntry.rgeValue = "&H" & Hex$(fTempDbl)
                    End If
                    RegEntry.rgeValue = RegEntry.rgeValue & " (" & Format$(fTempDbl) & ")"

                Case REG_BINARY

                    ' --------------------------------------
                    ' Binary values may be of any length,
                    '   and may represent text or other data.
                    ' They require a special editor to
                    '   modify them.
                    ' --------------------------------------
                    Item.SmallIcon = 5
                    For iTempInt = 1 To Len(RegEntry.rgeValue)
                        sBinaryString = sBinaryString & Format$(Hex(Asc(Mid$(RegEntry.rgeValue, iTempInt, 1))), "00") & " "
                    Next iTempInt
                    RegEntry.rgeValue = sBinaryString
            End Select

            If Len(RegEntry.rgeValue) = 0 Then
                RegEntry.rgeValue = "(value not set)"
            End If


            ' -----------------------------------------------
            ' Enter the value into the list box
            ' -----------------------------------------------
            Item.Text = RegEntry.rgeEntry
            Item.SubItems(1) = RegEntry.rgeValue
            Item.Tag = CStr(lKeyIndx)
            ' -----------------------------------------------
            ' Increment the key and do it again.
            ' -----------------------------------------------
            lKeyIndx = lKeyIndx + 1

        ElseIf lRtn = ERROR_MORE_DATA Then
            ' -----------------------------------------------
            ' This error means that, despite querying the key,
            '   we have not set one of the buffers large
            '   enough.  Increment the buffer sizes and try
            '   again
            ' -----------------------------------------------
            lMaxValueData = lMaxValueData + 5
            lMaxValueName = lMaxValueName + 5
            GoTo ReTryValueEnumeration

        ElseIf lRtn = ERROR_NO_MORE_ITEMS Then
            ' -----------------------------------------------
            ' Not an error, just end of list -- exit the
            '   loop
            ' -----------------------------------------------
            lRtn = ERROR_SUCCESS
            Exit Do

        Else
            ' --------------------------------------------------
            ' Key still open, so display the error and fall
            '   thru to the close function below
            ' --------------------------------------------------
            MsgBox RtnRegError(lRtn)
            Exit Do
        End If
    Loop

    ' -----------------------------------------------------
    ' Always close opened keys!
    ' -----------------------------------------------------
    lRtn = RegCloseKey(hKey)

End Sub

Public Sub RegGetValue()

    '----------------------------------------------------------
    'This Sub is not used by this demo, but it is provided as an
    'encapsulation of the RegQueryValueEx function
    '----------------------------------------------------------

    ' --------------------------------------------------------
    ' RegEntry must be pre-filled with a key in rgeSubKey, and
    ' rgeEntry.  This sub will fill the rgeDataType and rgeValue items,
    ' as well as the rgeMainKey if that is not already filled.
    ' --------------------------------------------------------
    Dim lRtn&        'returned by registry functions, should be 0&
    Dim hKey&        'return handle to opened key
    Dim lData&       'length of data in returned string

    '------------------------
    'values for QueryInfoKey:
    '------------------------
    Dim sClassName$
    Dim lClassLen&
    Dim lSubKeys&
    Dim lMaxSubKey&
    Dim lMaxClass&
    Dim lValues&
    Dim lMaxValueName&
    Dim lMaxValueData&
    Dim lSecurityDesc&
    Dim strucLastWriteTime As FILETIME

      RegEntry.rgeExtractKeys

      ' --------------------------------------------------
      ' Open key
      ' --------------------------------------------------
      lRtn = RegOpenKeyEx(RegEntry.rgeMainKey, RegEntry.rgeSubKey, 0&, KEY_READ, hKey)
      If lRtn <> ERROR_SUCCESS Then
          MsgBox RtnRegError(lRtn)
          RegEntry.rgeClear
          Exit Sub          'No key open, so leave
      End If

      ' --------------------------------------------------
      'use RegQueryInfoKey to get the maximum value data info.
      ' --------------------------------------------------
      sClassName = Space$(255)
      lClassLen = CLng(Len(sClassName))
      lRtn = RegQueryInfoKey(hKey, sClassName, lClassLen, 0&, lSubKeys, lMaxSubKey, lMaxClass, lValues, lMaxValueName, lMaxValueData, lSecurityDesc, strucLastWriteTime)

      ' --------------------------------------------------
      ' Set up buffer for data to be returned in.
      ' --------------------------------------------------
      RegEntry.rgeValue = Space$(lMaxValueName + 1)
      lData = Len(RegEntry.rgeValue)

      ' --------------------------------------------------
      ' Read key
      ' --------------------------------------------------
      lRtn = RegQueryValueEx(hKey, RegEntry.rgeEntry, 0&, RegEntry.rgeDataType, RegEntry.rgeValue, lData)
      If lRtn <> ERROR_SUCCESS Then
          ' -----------------------------------------------
          ' Key still open, so finish up
          ' -----------------------------------------------
          MsgBox RtnRegError(lRtn)
          RegEntry.rgeClear
      End If


      ' --------------------------------------------------
      ' Always close opened keys!
      ' --------------------------------------------------
      lRtn = RegCloseKey(hKey)

End Sub

Sub RegSetValue()
    ' --------------------------------------------------------
    ' DWORD Values must be in Hex form for this function to
    '   work.
    ' --------------------------------------------------------
    Dim lRtn&            'returned by registry functions, should be 0&
    Dim hKey&         'return handle to opened key
    Dim iFirstChar%
    Dim iSecondChar%
    Dim iThirdChar%
    Dim iFourthChar%

    If RegEntry.rgeDataType <> REG_SZ And RegEntry.rgeDataType <> REG_DWORD Then
        MsgBox "This demo only supports writing keys of the types REG_SZ and REG_DWORD.  This key uses a different type."
        Exit Sub
    End If

    ' -----------------------------------------------------
    ' Check rgeMainKey for validity
    ' -----------------------------------------------------
    If RegEntry.rgeMainKey >= &H80000000 And RegEntry.rgeMainKey <= &H80000006 Then

        ' -----------------------------------------------------
        ' Open key
        ' -----------------------------------------------------
        lRtn = RegOpenKeyEx(RegEntry.rgeMainKey, RegEntry.rgeSubKey, 0&, KEY_WRITE, hKey)
        If lRtn <> ERROR_SUCCESS Then
            MsgBox RtnRegError(lRtn)
            RegEntry.rgeClear
            Exit Sub       'No key open, so leave
        End If

        ' -----------------------------------------------------
        ' Write new RegEntry.rgeValue to key
        ' -----------------------------------------------------
        If RegEntry.rgeDataType = REG_DWORD Then
            RegEntry.rgeValue = Left(Trim(RegEntry.rgeValue), 8)
            If Left$(RegEntry.rgeValue, 2) <> "&H" Then
            RegEntry.rgeValue = "&H" & Left(Trim(RegEntry.rgeValue), 8)
            End If
            If Len(RegEntry.rgeValue) <= 6 Then
            RegEntry.rgeValue = RegEntry.rgeValue & "&"
            End If

            ' -----------------------------------------------------
                'Convert number string to 32-bit DWORD and save:
            ' -----------------------------------------------------
            lRtn = RegSetValueEx(hKey, RegEntry.rgeEntry, 0&, RegEntry.rgeDataType, CLng(Val(RegEntry.rgeValue)), 4&)
        Else

            ' -----------------------------------------------------
                'Save type REG_SZ (strings)
            ' -----------------------------------------------------
            lRtn = RegSetValueEx(hKey, RegEntry.rgeEntry, 0&, RegEntry.rgeDataType, ByVal RegEntry.rgeValue, CLng(Len(RegEntry.rgeValue)))
        End If
        If lRtn <> ERROR_SUCCESS Then
            MsgBox RtnRegError(lRtn) 'Key still open, so finish up
        End If
        ' -----------------------------------------------------
        ' Always close opened keys!
        ' -----------------------------------------------------
        lRtn = RegCloseKey(hKey)
    End If
End Sub

Private Function RtnRegError$(errorcode&)
    Select Case errorcode
        Case 1009, 1015
            ' -----------------------------------------------------
                'We're in trouble now
            ' -----------------------------------------------------
            RtnRegError = "The Registry Database is corrupt!"
        Case 2, 1010
            RtnRegError = "Bad Key Name!"
        Case 1011
            RtnRegError = "Can't Open Key"
        Case 4, 1012
            RtnRegError = "Can't Read Key"
        Case 5
            RtnRegError = "Access to this key is denied."
        Case 1013
            RtnRegError = "Can't Write Key"
        Case 8, 14
            RtnRegError = "Out of memory"
        Case 87
            RtnRegError = "Invalid Parameter"
        Case 234
            RtnRegError = "Error - There is more data than the buffer can handle!"
        Case Else
            RtnRegError = "Undefined Key Error Code" & Str$(errorcode) & "!"
    End Select
End Function

Function WordLo(lLongIn&) As Integer
    If (lLongIn And &HFFFF&) > &H7FFF Then
        WordLo = (lLongIn And &HFFFF&) - &H10000
    Else
        WordLo = lLongIn And &HFFFF&
    End If
End Function